home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Workbench Add-On
/
Workbench Add-On - Volume 1.iso
/
Dev
/
SmallTalk
/
CompiledMethod.st
< prev
next >
Wrap
Text File
|
1995-08-25
|
18KB
|
606 lines
"======================================================================
|
| CompiledMethod Method Definitions
|
======================================================================"
"======================================================================
|
| Copyright (C) 1990, 1991, 1992 Free Software Foundation, Inc.
| Written by Steve Byrne.
|
| This file is part of GNU Smalltalk.
|
| GNU Smalltalk is free software; you can redistribute it and/or modify it
| under the terms of the GNU General Public License as published by the Free
| Software Foundation; either version 1, or (at your option) any later version.
|
| GNU Smalltalk is distributed in the hope that it will be useful, but WITHOUT
| ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS
| FOR A PARTICULAR PURPOSE. See the GNU General Public License for more
| details.
|
| You should have received a copy of the GNU General Public License along with
| GNU Smalltalk; see the file COPYING. If not, write to the Free Software
| Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
|
======================================================================"
"
| Change Log
| ============================================================================
| Author Date Change
| sbb 15 Sep 91 Adjusted to account for larger numbers of primitives,
| literals, and temporaries.
|
| sbb 16 Mar 91 Class creation now separate statement.
|
| sbb 22 Sep 90 Fixed printOn method to account for change to String
| printOn:.
|
| sbyrne 27 Dec 89 Added real print method for compiled methods.
|
| sbyrne 6 Sep 89 Added lots of methods: inspect, =, hash, method
| cateogry, methodSourceCode, methodSourceString, and
| some private accessors such as bytecodeAt:.
|
| sbyrne 25 Apr 89 created.
|
"
ArrayedCollection variableByteSubclass: #CompiledMethod
instanceVariableNames: 'descriptor methodHeader'
classVariableNames: ''
poolDictionaries: ''
category: nil
!
CompiledMethod comment:
'I represent methods that have been compiled. I can recompile
methods from their source code, I can invoke Emacs to edit the source code
for one of my instances, and I know how to access components of my
instances.' !
"Make sure that this symbol is defined, even if it doesn't work just
yet."
Smalltalk at: #Debugger put: nil!
!CompiledMethod methodsFor: 'basic'!
methodCategory
^descriptor category
!
methodCategory: aCategory
^descriptor category: aCategory
!
methodSourceCode
^descriptor sourceCode
!
methodSourceString
^descriptor sourceString
!
methodSourceFile
^descriptor sourceFile
!
methodSourcePos
^descriptor sourcePos
!
= aMethod
descriptor = aMethod getDescriptor ifFalse: [ ^false ].
methodHeader = aMethod getHeader ifFalse: [ ^false ].
1 to: self numLiterals do:
[ :i | (self literalAt: i) = (aMethod literalAt: i)
ifFalse: [ ^false ] ].
1 to: self numBytecodes do:
[ :i | (self bytecodeAt: i) = (aMethod bytecodeAt: i)
ifFalse: [ ^false ] ].
^true
!
hash
| hashValue |
hashValue _ descriptor hash.
hashValue _ ((hashValue bitShift: 1)
bitXor: methodHeader hash)
bitAnd: 16r1FFFFFFF.
1 to: self numLiterals do:
[ :i | hashValue _ ((hashValue bitShift: 1)
bitXor: (self literalAt: i) hash)
bitAnd: 16r1FFFFFFF ].
1 to: self numBytecodes do:
[ :i | hashValue _ ((hashValue bitShift: 1)
bitXor: (self bytecodeAt: i) hash)
bitAnd: 16r1FFFFFFF ].
^hashValue
!!
!CompiledMethod methodsFor: 'method header accessors'!
"The structure of a method header is as follows (from mstinterp.h)
### fix this up
3 2 1
1 0 9 8 7 6 5 4 3 2 1 0 9 8 7 6 5 4 3 2 1 0 9 8 7 6 5 4 3 2 1 0
+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
|1|.|.|.|.|.|flg| prim index | #args | #temps | #literals |
+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
literals 6 0..5
temporarycount 5 6..10
args 5 11..15
primitiveIndex 8 16..23
flags 2 24-25
flags 0 -- use arguments as they are, ignore prim index
flags 1 -- return self
flags 2 -- return instance variable
flags 3 -- call the primitive indexed by primIndex
"
flags
"The xor here is related to 1) the fact that the the flags field overlaps
with the penultimate msb, and 2) the way that integers are encoded."
^((methodHeader bitShift: -29) bitAnd: 16r3) bitXor: 2
!
primitive
^(methodHeader bitShift: -19) bitAnd: 16r3FF
!
numArgs
| flags |
flags _ self flags.
(flags = 2) | (flags = 3)
ifTrue: [ ^0 ].
^(methodHeader bitShift: -14) bitAnd: 16r1F
!
numTemps
self flags = 0
ifFalse: [ ^0 ].
^(methodHeader bitShift: -8) bitAnd: 16r3F
!
numLiterals
self flags = 0
ifFalse: [ ^0 ].
^methodHeader bitAnd: 16rFF
!!
!CompiledMethod methodsFor: 'copying'!
shallowCopy
^(CompiledMethod newMethod: self basicSize
header: methodHeader) shallowCopyMethodContents: self
!
deepCopy
^(CompiledMethod newMethod: self basicSize
header: methodHeader) deepCopyMethodContents: self
!!
!CompiledMethod methodsFor: 'debugging'!
inspect
| class instVars |
class _ self class.
instVars _ class instVarNames.
stdout nextPutAll: 'An instance of '.
class printNl.
1 to: (instVars size - 1) do: "assumes methodHeader is last inst var"
[ :i | stdout nextPutAll: ' ';
nextPutAll: (instVars at: i);
nextPutAll: ': '.
(self objectAt: i) printNl ].
stdout nextPutAll: ' Header Flags: '; nl;
nextPutAll: ' flags: '.
self flags printNl.
stdout nextPutAll: ' primitive index: '.
self primitive printNl.
stdout nextPutAll: ' number of arguments: '.
self numArgs printNl.
stdout nextPutAll: ' number of temporaries: '.
self numTemps printNl.
stdout nextPutAll: ' number of literals: '.
self numLiterals printNl.
self numLiterals > 0
ifTrue: [ stdout nextPutAll: ' literals: ['; nl.
1 to: self numLiterals do:
[ :i | stdout nextPutAll: ' '.
i print.
stdout nextPutAll: ': '.
(self literalAt: i) storeNl ].
stdout nextPutAll: ' ]'; nl ]
!!
!CompiledMethod methodsFor: 'debugging'!
breakpointAt: byteIndex
"self notYetImplemented"
Debugger recordOldByte: (self bytecodeAt: byteIndex)
atIndex: byteIndex
forMethod: self.
self bytecodeAt: byteIndex put: Debugger debugByte
!
breakAtLine: lineNumber
self notYetImplemented
!
removeBreakpointAt: byteIndex
| oldByte |
oldByte _ Debugger origByteAt: byteIndex forMethod: self.
oldByte notNil
ifTrue: [ self bytecodeAt: byteIndex put: oldByte ]
!!
!CompiledMethod methodsFor: 'printing'!
printOn: aStream
"### This could be more interesting, such as calling the decompiler, or
printing out the byte codes, or ... yeah, yeah, that's it, the byte
codes...also need to decode the header information to display that
interesting information"
| primIndex numLits |
true
ifTrue: [ aStream nextPutAll: 'a CompiledMethod' ]
ifFalse:
[ aStream nextPutAll: 'Header Info: '.
(primIndex _ self primitive) > 0
ifTrue: [ aStream nextPutAll: 'Primitive: ' ].
numLits _ self numLiterals.
aStream nextPutAll: ' # Args: '.
(self numArgs) printOn: aStream.
aStream nextPutAll: ' # Temps: '.
(self numTemps) printOn: aStream.
aStream nextPutAll: ' # Literals: '.
numLits printOn: aStream. aStream nl.
numLits > 0
ifTrue: [ aStream nextPutAll: 'Literals'; nl;
nextPutAll: '--------'; nl.
1 to: numLits do:
[ :i | aStream nextPutAll: ' ['.
i printOn: aStream.
aStream nextPutAll: ']: '.
(self literalAt: i) printOn: aStream.
aStream nl ] ].
" Emit header info here too "
aStream nextPutAll: 'Byte codes'; nl;
nextPutAll: '----------'; nl.
self printByteCodesOn: aStream ]
!
storeOn: aStream
self printOn: aStream
!!
!CompiledMethod methodsFor: 'private'!
shallowCopyMethodContents: aMethod
"Don't need to copy the method header; it's already done"
descriptor _ aMethod getDescriptor.
1 to: aMethod numLiterals do:
[ :i | self literalAt: i put: (aMethod literalAt: i) ].
1 to: aMethod numBytecodes do:
[ :i | self bytecodeAt: i put: (aMethod bytecodeAt: i) ]
!
deepCopyMethodContents: aMethod
"Don't need to copy the method header; it's already done"
descriptor _ aMethod getDescriptor deepCopy.
1 to: aMethod numLiterals do:
[ :i | self literalAt: i put: (aMethod literalAt: i) deepCopy ].
1 to: aMethod numBytecodes do:
[ :i | self bytecodeAt: i put: (aMethod bytecodeAt: i) ]
!
printByteCodesOn: aStream
| numBytes i |
i _ 1.
numBytes _ self numBytecodes.
[ i <= numBytes ] whileTrue:
[ i _ i + (self printByteAt: i on: aStream) ]
!
printByteAt: anIndex on: aStream
| byte nextByte skip |
byte _ self bytecodeAt: anIndex.
byte == 127 "Debugger debugByte"
ifTrue: [ byte _ Debugger origByteAt: anIndex forMethod: self ].
skip _ 1.
aStream nextPutAll: ' ['.
anIndex printOn: aStream.
aStream nextPutAll: ']: '.
byte < 95 ifTrue:
[ self printIndexedAt: anIndex on: aStream ].
(byte between: 96 and: 111) ifTrue:
[ self emitSimplePop: byte on: aStream ].
(byte between: 112 and: 125) ifTrue:
[ self emitBuiltin: byte on: aStream ].
"127 is the debugger breakpoint and we don't get it here"
byte == 128 ifTrue:
[ skip _ 2.
self print2BytePush: (self bytecodeAt: anIndex + 1) on: aStream ].
byte == 129 ifTrue:
[ skip _ 2.
self print2ByteStackOp: 'store' at: anIndex on: aStream ].
byte == 130 ifTrue:
[ skip _ 2.
self print2ByteStackOp: 'pop and store' at: anIndex on: aStream ].
(byte between: 131 and: 134) ifTrue:
[ skip _ self emitIndexedSend: anIndex on: aStream ].
byte == 135 ifTrue:
[ aStream nextPutAll: 'pop stack top ' ].
byte == 136 ifTrue:
[ aStream nextPutAll: 'duplicate stack top' ].
byte == 137 ifTrue:
[ aStream nextPutAll: 'push current context' ].
(byte between: 138 and: 143) ifTrue:
[ aStream nextPutAll: 'ILLEGAL bytecode '.
byte printOn: aStream ].
(byte between: 144 and: 175) ifTrue:
[ skip _ self printJump: anIndex on: aStream ].
(byte between: 176 and: 191) ifTrue:
[ aStream nextPutAll: 'send arithmetic message "'.
(#(+ - < >
<= >= = ~=
* / \\ @
bitShift: // bitAnd: bitOr:)
at: (byte bitAnd: 15) + 1) printOn: aStream.
aStream nextPut: $" ].
(byte between: 192 and: 207) ifTrue:
[ aStream nextPutAll: 'send special message "'.
(#(at: at:put: size next
nextPut: atEnd == class
blockCopy: value value: do:
new new: x y)
at: (byte bitAnd: 15) + 1) printOn: aStream.
aStream nextPut: $" ].
(byte between: 208 and: 255) ifTrue:
[ self printSmallArgSend: byte on: aStream ].
aStream nl.
^skip
!
printIndexedAt: anIndex on: aStream
| byte index |
byte _ self bytecodeAt: anIndex.
byte <= 15 ifTrue:
[ ^self pushIndexed: 'Instance Variable'
withIndex: (byte bitAnd: 15)
on: aStream ].
byte <= 31 ifTrue:
[ ^self pushIndexed: 'Temporary'
withIndex: (byte bitAnd: 15)
on: aStream ].
byte <= 63 ifTrue:
[ ^self pushIndexed: 'Literal'
withIndex: (byte bitAnd: 31)
on: aStream ].
" >= 64 case here "
aStream nextPutAll: 'push Global Variable['.
(byte bitAnd: 31) printOn: aStream.
aStream nextPutAll: '] = '.
self printAssociationKeyFor: (byte bitAnd: 31) on: aStream
!
pushIndexed: indexLabel withIndex: anIndex on: aStream
aStream nextPutAll: 'push '.
indexLabel printOn: aStream.
aStream nextPut: $[.
anIndex printOn: aStream.
aStream nextPut: $]
!
emitSimplePop: byte on: aStream
(byte between: 96 and: 103) ifTrue:
[ aStream nextPutAll: 'pop and store instance variable['.
(byte bitAnd: 7) printOn: aStream.
aStream nextPut: $] ].
(byte between: 104 and: 111) ifTrue:
[ aStream nextPutAll: 'pop and store Temporary['.
(byte bitAnd: 7) printOn: aStream.
aStream nextPut: $] ].
!
emitBuiltin: byte on: aStream
byte == 112 ifTrue: [ aStream nextPutAll: 'push self' ].
byte == 113 ifTrue: [ aStream nextPutAll: 'push true' ].
byte == 114 ifTrue: [ aStream nextPutAll: 'push false' ].
byte == 115 ifTrue: [ aStream nextPutAll: 'push nil' ].
byte == 116 ifTrue: [ aStream nextPutAll: 'push -1' ].
byte == 117 ifTrue: [ aStream nextPutAll: 'push 0' ].
byte == 118 ifTrue: [ aStream nextPutAll: 'push 1' ].
byte == 119 ifTrue: [ aStream nextPutAll: 'push 2' ].
byte == 120 ifTrue: [ aStream nextPutAll: 'return self' ].
byte == 121 ifTrue: [ aStream nextPutAll: 'return true' ].
byte == 122 ifTrue: [ aStream nextPutAll: 'return false' ].
byte == 123 ifTrue: [ aStream nextPutAll: 'return nil' ].
byte == 124 ifTrue: [ aStream nextPutAll: 'return Message stack top' ].
byte == 125 ifTrue: [ aStream nextPutAll: 'return Block stack top' ].
byte == 126 ifTrue: [ aStream nextPutAll: '### ILLEGAL BYTE CODE 126 ###' ]
!
print2BytePush: byte on: aStream
self printIndexedPush: (byte bitAnd: 63)
type: (byte bitShift: -6)
on: aStream
!
printIndexedPush: index type: typeIndex on: aStream
| typeName |
typeName _ self indexedLocationName: typeIndex.
aStream nextPutAll: 'push ';
nextPutAll: typeName;
nextPutAll: '['.
index printOn: aStream.
aStream nextPut: $].
typeIndex = 3 ifTrue:
[ aStream nextPutAll: ' = '.
self printAssociationKeyFor: index
on: aStream ]
!
indexedLocationName: locIndex
^#('Instance Variable' 'Temporary' 'Literal' 'Global Variable')
at: locIndex + 1
!
print2ByteStackOp: opName at: anIndex on: aStream
| nextByte locationName locIndex |
nextByte _ self bytecodeAt: anIndex + 1.
locIndex _ nextByte bitShift: -6.
locationName _ self indexedLocationName: locIndex.
locIndex == 2 ifTrue: [ aStream nextPutAll: 'ILLEGAL ' ].
aStream nextPutAll: opName;
nextPutAll: locationName;
nextPutAll:'['.
(nextByte bitAnd: 63) printOn: aStream.
aStream nextPut: $].
locIndex == 3 ifTrue:
[ aStream nextPutAll: ' = '.
self printAssociationKeyFor: (nextByte bitAnd: 63) on: aStream ]
!
emitIndexedSend: anIndex on: aStream
| byte byte1 byte2 toSuper |
byte _ self bytecodeAt: anIndex.
byte _ byte - 131. "transform to 0..3"
byte <= 1 ifTrue: [ toSuper _ '' ]
ifFalse: [ toSuper _ 'to Super ' ].
(byte == 0) | (byte == 2)
ifTrue:
[ byte1 _ self bytecodeAt: anIndex + 1.
self emitGenericSend: toSuper index: (byte1 bitAnd: 31)
args: (byte1 bitShift: -5) on: aStream.
^2 ]
ifFalse:
[ byte1 _ self bytecodeAt: anIndex + 1.
byte2 _ self bytecodeAt: anIndex + 2.
self emitGenericSend: toSuper index: byte2
args: byte1 on: aStream.
^3]
!
emitGenericSend: toSuper index: anIndex args: numArgs on: aStream
aStream nextPutAll: 'send ';
nextPutAll: toSuper;
nextPutAll: 'selector '.
anIndex printOn: aStream.
aStream nextPutAll: ', '.
numArgs printOn: aStream.
aStream nextPutAll: ' args = '.
self printLiteralSymbolAt: anIndex on: aStream
!
printJump: anIndex on: aStream
| byte |
byte _ self bytecodeAt: anIndex.
byte <= 151 ifTrue:
[ aStream nextPutAll: 'jump to '.
((byte bitAnd: 7) + anIndex + 1 + 1 ) printOn: aStream.
^1 ].
byte <= 159 ifTrue:
[ aStream nextPutAll: 'jump to '.
((byte bitAnd: 7) + anIndex + 1 + 1 ) printOn: aStream.
aStream nextPutAll: ' if false'.
^1 ].
byte <= 167 ifTrue:
[ aStream nextPutAll: 'jump to '.
(((byte bitAnd: 7) - 4) * 256 + (self bytecodeAt: anIndex + 1)
+ anIndex + 2) printOn: aStream.
^2 ].
byte <= 171 ifTrue:
[ aStream nextPutAll: 'pop and jump to '.
((byte bitAnd: 3) * 256 + (self bytecodeAt: anIndex + 1)
+ anIndex + 2) printOn: aStream.
aStream nextPutAll: ' if true'.
^2 ].
byte <= 175 ifTrue:
[ aStream nextPutAll: 'pop and jump to '.
((byte bitAnd: 3) * 256 + (self bytecodeAt: anIndex + 1)
+ anIndex + 2) printOn: aStream.
aStream nextPutAll: ' if false'.
^2 ]
!
printSmallArgSend: byte on: aStream
| numArgs |
byte _ byte - 208.
numArgs _ byte // 16.
aStream nextPutAll: 'send selector '.
(byte bitAnd: 15) printOn: aStream.
aStream nextPutAll: ', '.
numArgs printOn: aStream.
numArgs == 1
ifTrue: [ aStream nextPutAll: ' arg' ]
ifFalse: [ aStream nextPutAll: ' args' ].
aStream nextPutAll: ' = '.
self printLiteralSymbolAt: (byte bitAnd: 15) on: aStream
!
printAssociationKeyFor: anIndex on: aStream
| assoc |
assoc _ self literalAt: anIndex + 1.
assoc key printOn: aStream
!
printLiteralSymbolAt: anIndex on: aStream
(self literalAt: anIndex + 1) printOn: aStream
!
getDescriptor
^descriptor
!
getHeader
^methodHeader
!
literalAt: anIndex
^self objectAt: (anIndex + 2)
!
literalAt: anInteger put: aValue
self objectAt: anInteger + 2 put: aValue
!
numBytecodes
^(self basicSize) - (self bytecodeStart)
!
bytecodeAt: anIndex
^self basicAt: (anIndex + self bytecodeStart)
!
bytecodeAt: anIndex put: aValue
^self basicAt: (anIndex + self bytecodeStart) put: aValue
!
bytecodeStart
^4 * self numLiterals
!!